home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / pascal2 / pro7 / freemem.pas < prev    next >
Pascal/Delphi Source File  |  1986-11-01  |  3KB  |  108 lines
  1. {TITLE: Report free memory size}
  2. Program Memory;
  3.  
  4. {Written by David G. Holm. Bix ID dgh. This program is in the public domain.}
  5. {WriteHex written by Jim Keohane (from his Turbo Pascal program Zap).}
  6.  
  7. Type
  8.  
  9.   Flag_F_Type = (Carry,X1,Parity,X3,AuxCarry,X5,Zero,Sign,
  10.                  Trap,InterruptEnable,Direction,Overflow,X12,X13,X14,X15);
  11.  
  12.   FlagType = record case integer of
  13.     1: (f: set of Flag_F_Type);
  14.     2: (i: integer);
  15.   end;
  16.  
  17.   RegBank = Record Case Boolean Of
  18.               True: (AX,BX,CX,DX,BP,SI,DI,DS,ES: Integer;
  19.                      Flags: FlagType;);
  20.               False: (AL,AH,BL,BH,CL,CH,DL,DH: Byte;);
  21.             END;
  22.  
  23. Var
  24.   Regs: RegBank;
  25.   MemSize: Real;
  26.  
  27. Procedure WriteHex(Val: Byte);
  28.  
  29. Const Hex: Array[0..15] Of Char = '0123456789ABCDEF';
  30.       Hexs: String[15]='123456789ABCDEF';
  31.  
  32. Var Zz: Integer;
  33.  
  34. Begin
  35.   For Zz:=1 To 2 Do
  36.   Begin
  37.     Case Zz Of
  38.       0:Write(chr(val));
  39.       1:Write(Hex[val shr 4]);
  40.       2:Write(Hex[val and 15])
  41.     End
  42.   End;
  43. End;
  44.  
  45. Procedure WriteHex4 (Val: Integer);
  46. Begin
  47.   WriteHex (Hi(Val));
  48.   WriteHex (Lo(Val));
  49. End;
  50.  
  51. Procedure WriteMemoryError;
  52. Begin
  53.   Case Regs.AX of
  54.     7: WriteLn ('Arena trashed.');
  55.     8: WriteLn ('Not enough memory.');
  56.     9: WriteLn ('Invalid block.');
  57.     else
  58.   End {case}
  59. End;
  60.  
  61. Begin
  62.   Write ('Memory: ');
  63. (*DEBUG START
  64.   writeln ('Modify memory allocation block.');
  65. DEBUG STOP*)
  66.   Regs.AH := $4A;             {Modify Memory Allocation Block}
  67.   Regs.BX := $1000;           {Cut allocated memory down to 64 K-bytes}
  68.   Regs.ES := Cseg;            {Com file...}
  69.   MsDos (Regs);
  70. (*DEBUG START
  71.   writehex4(regs.ax);
  72.   write(' ');
  73.   writehex4(regs.bx);
  74.   write(' ');
  75.   writehex4(regs.flags.i);
  76.   writeln;
  77. DEBUG STOP*)
  78.   If Carry in Regs.Flags.F
  79.   Then WriteMemoryError
  80.   Else
  81.   Begin
  82. (*DEBUG START
  83.     writeln ('Allocate memory.');
  84. DEBUG STOP*)
  85.     Regs.AH := $48;             {Allocate memory}
  86.     Regs.BX := -1;              {Allocate more than could possibly be available}
  87.     MsDos (Regs);
  88. (*DEBUG START
  89.     writehex4(regs.ax);
  90.     write(' ');
  91.     writehex4(regs.bx);
  92.     write(' ');
  93.     writehex4(regs.flags.i);
  94.     writeln;
  95. DEBUG STOP*)
  96.     If (Carry in Regs.Flags.F)
  97.     Then If Regs.Ax <> 8
  98.     Then WriteMemoryError
  99.     Else
  100.     Begin
  101.       MemSize := Regs.BX + $1000; {Add in memory size of program}
  102.       MemSize := MemSize * 16;
  103.       Writeln (MemSize:1:0, ' bytes free.');
  104.     End
  105.     Else Writeln ('Over 1 Megabyte free.')
  106.   End;
  107. End.
  108.